home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b1tex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  17.2 KB  |  714 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /*
  4.  * $Header: b1tex.c,v 1.4 85/08/22 16:52:36 timo Exp $
  5.  */
  6.  
  7. /* B texts */
  8.  
  9. #include "b.h"
  10. #include "b1obj.h"
  11. #ifndef INTEGRATION
  12. #include "b0con.h"
  13. #include "b1mem.h"
  14. #include "b1btr.h"
  15. #include "b1val.h"
  16. #endif
  17. #include "b1tlt.h"
  18. #include "b3err.h"
  19.  
  20. #ifndef INTEGRATION
  21.  
  22. /*
  23.  * Operations on texts represented as B-trees.
  24.  *
  25.  * Comments:
  26.  * - The functions with 'i' prepended (ibehead, etc.) do no argument
  27.  *   checking at all.  They actually implement the planned behaviour
  28.  *   of | and @, where out-of-bounds numerical values are truncated
  29.  *   rather than causing errors ("abc"|100 = "abc"@-100 = "abc").
  30.  * - The 'size' field of all texts must fit in a C int.  If the result of
  31.  *   ^ or ^^ would exceed Maxint in size, a user error is signalled.  If
  32.  *   the size of the *input* value(s) of any operation is Bigsize, a syserr
  33.  *   is signalled.
  34.  * - Argument checking: trims, concat and repeat must check their arguments
  35.  *   for user errors.
  36.  * - t^^n is implemented with an algorithm similar to the 'square and
  37.  *   multiply' algorithm for x**n, using the binary representation of n,
  38.  *   but it uses straightforward 'concat' operations.  A more efficient
  39.  *   scheme is possible [see IW219], but small code seems more important.
  40.  * - Degenerated cases (e.g. t@1, t|0, t^'' or t^^n) are not optimized,
  41.  *   but produce the desired result by virtue of the algorithms used.
  42.  *   The extra checking does not seem worth the overhead for the
  43.  *   non-degenerate cases.
  44.  * - The code for PUT v IN t@h|l is still there, but it is not compiled,
  45.  *   as the interpreter implements the same strategy directly.
  46.  * - 'trim()' is only used by f_uname in "b3fil.c".
  47.  * - Code for outputting texts has been added.    This is called from wri()
  48.  *   to output a text, and has running time O(n), compared to O(n log n)
  49.  *   for the old code in wri().
  50.  *
  51.  * *** WARNING ***
  52.  * - The 'zip' routine and its subroutine 'copynptrs' assume that items and
  53.  *   pointers are stored contiguously, so that &Ptr(p, i+1) == &Ptr(p, i)+1
  54.  *   and &[IB]char(p, i+1) == &[IB]char(p, i)+1.  For pointers, the order
  55.  *   might be reversed in the future; then change the macro Incr(pp, n) below
  56.  *   to *decrement* the pointer!
  57.  * - Mkbtext and bstrval make the same assumption about items (using strncpy
  58.  *   to move charaters to/from a bottom node).
  59.  */
  60.  
  61. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  62.  
  63. #define IsInner(p) (Flag(p) == Inner)
  64. #define IsBottom(p) (Flag(p) == Bottom)
  65.  
  66. #define Incr(pp, n) ((pp) += (n))
  67.  
  68. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  69.  
  70. /* make a B text out of a C char */
  71.  
  72. Visible value mkchar(c) char c; {
  73.     char buf[2];
  74.     buf[0] = c;
  75.     buf[1] = '\0';
  76.     return mk_text(buf);
  77. }
  78.  
  79. Visible char charval(v) value v; {
  80.     if (!Character(v))
  81.         syserr(MESS(1600, "charval on non-char"));
  82.     return Bchar(Root(v), 0);
  83. }
  84.  
  85. Visible bool character(v) value v; {
  86.     return Character(v);
  87. }
  88.  
  89. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  90.  
  91. Hidden btreeptr mkbtext(s, len) string s; int len; {
  92.     btreeptr p; int chunk, i, n, nbig;
  93.  
  94.     /*
  95.      * Determine level of tree.
  96.      * This is done for each inner node anew, to avoid having
  97.      * to keep an explicit stack.
  98.      * Problem is: make sure that for each node at the same
  99.      * level, the computation indeed finds the same level!
  100.      * (Don't care about efficiency here; in practice the trees
  101.      * built by mk_text rarely need more than two levels.)
  102.      */
  103.     chunk = 0;
  104.     i = Maxbottom; /* Next larger chunk size */
  105.     while (len > i) {
  106.         chunk = i;
  107.         i = (i+1) * Maxinner + Maxinner;
  108.     }
  109.     n = len / (chunk+1); /* Number of items at this level; n+1 subtrees */
  110.     chunk = len / (n+1); /* Use minimal chunk size for subtrees */
  111.     p = grabbtreenode(chunk ? Inner : Bottom, Ct);
  112.     Size(p) = len;
  113.     Lim(p) = n;
  114.     if (!chunk)
  115.         strncpy(&Bchar(p, 0), s, len);
  116.     else {
  117.         nbig = len+1 - (n+1)*chunk;
  118.             /* There will be 'nbig' nodes of size 'chunk'. */
  119.             /* The remaining 'n-nbig' will have size 'chunk-1'. */
  120.         for (i = 0; i < n; ++i) {
  121.             Ptr(p, i) = mkbtext(s, chunk);
  122.             s += chunk;
  123.             Ichar(p, i) = *s++;
  124.             len -= chunk+1;
  125.             if (--nbig == 0)
  126.                 --chunk; /* This was the last 'big' node */
  127.         }
  128.         Ptr(p, i) = mkbtext(s, len);
  129.     }
  130.     return p;
  131. }
  132.  
  133. Visible value mk_text(s) string s; {
  134.     value v; int len = strlen(s);
  135.  
  136.     v = grab_tlt(Tex, Ct);
  137.     if (len == 0)
  138.         Root(v) = Bnil;
  139.     else
  140.         Root(v) = mkbtext(s, len);
  141.     return v;
  142. }
  143.  
  144. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  145.  
  146. Hidden string bstrval(buf, p) string buf; btreeptr p; {
  147.     /* Returns *next* available position in buffer */
  148.     int i, n = Lim(p);
  149.     if (IsInner(p)) {
  150.         for (i = 0; i < n; ++i) {
  151.             buf = bstrval(buf, Ptr(p, i));
  152.             *buf++ = Ichar(p, i);
  153.         }
  154.         return bstrval(buf, Ptr(p, i));
  155.     }
  156.     strncpy(buf, &Bchar(p, 0), n);
  157.     return buf+n;
  158. }
  159.  
  160. Visible string strval(v) value v; {
  161.     static char *buffer; int len = Tltsize(v);
  162.     if (len == Bigsize) syserr(MESS(1601, "strval on big text"));
  163.     if (len == 0) return "";
  164.     if (buffer != NULL)
  165.         regetmem(&buffer, (unsigned) len+1);
  166.     else
  167.         buffer = getmem((unsigned) len+1);
  168.     *bstrval(buffer, Root(v)) = '\0';
  169.     return buffer;
  170. }
  171.  
  172. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  173.  
  174. typedef struct stackelem {
  175.     btreeptr s_ptr;
  176.     int s_lim;
  177. } stackelem;
  178.  
  179. typedef stackelem stack[Maxheight];
  180. typedef stackelem *stackptr;
  181.  
  182. #define Snil ((stackptr)0)
  183.  
  184. #define Push(s, p, l) ((s)->s_ptr = (p), ((s)->s_lim = (l)), (s)++)
  185. #define Pop(s, p, l) (--(s), (p) = (s)->s_ptr, (l) = (s)->s_lim)
  186.  
  187. extern stackptr unzip();
  188. extern Procedure cpynptrs();
  189. extern int movnptrs();
  190.  
  191. Hidden btreeptr zip(s1, sp1, s2, sp2) stackptr s1, sp1, s2, sp2; {
  192.     btreeptr p1, p2, newptr[2]; int l1, l2, i, n, n2;
  193. #define q1 newptr[0]
  194. #define q2 newptr[1]
  195.     char newitem; bool overflow, underflow, inner;
  196.     char *cp; btreeptr *pp;
  197.     char cbuf[2*Maxbottom]; btreeptr pbuf[2*Maxinner+2];
  198.  
  199.     while (s1 < sp1 && s1->s_lim == 0)
  200.         ++s1;
  201.     while (s2 < sp2 && s2->s_lim == Lim(s2->s_ptr))
  202.         ++s2;
  203.     inner = overflow = underflow = No;
  204.     q1 = Bnil;
  205.     while (s1 < sp1 || s2 < sp2) {
  206.         if (s1 < sp1)
  207.             Pop(sp1, p1, l1);
  208.         else
  209.             p1 = Bnil;
  210.         if (s2 < sp2)
  211.             Pop(sp2, p2, l2);
  212.         else
  213.             p2 = Bnil;
  214.         cp = cbuf;
  215.         if (p1 != Bnil) {
  216.             strncpy(cp, (inner ? &Ichar(p1, 0) : &Bchar(p1, 0)), l1);
  217.             cp += l1;
  218.         }
  219.         if (overflow)
  220.             *cp++ = newitem;
  221.         n = cp - cbuf;
  222.         if (p2 != Bnil) {
  223.             strncpy(cp, (inner ? &Ichar(p2, l2) : &Bchar(p2, l2)), Lim(p2)-l2);
  224.             n += Lim(p2)-l2;
  225.         }
  226.         if (inner) {
  227.             pp = pbuf; /***** Change if reverse direction! *****/
  228.             if (p1 != Bnil) {
  229.                 cpynptrs(pp, &Ptr(p1, 0), l1);
  230.                 Incr(pp, l1);
  231.             }
  232.             movnptrs(pp, newptr, 1+overflow);
  233.             Incr(pp, 1+overflow);
  234.             if (p2 != Bnil) {
  235.                 cpynptrs(pp, &Ptr(p2, l2+1), Lim(p2)-l2);
  236.                 Incr(pp, Lim(p2)-l2);
  237.             }
  238.             if (underflow) {
  239.                 underflow= No;
  240.                 n= uflow(n, p1 ? l1 : 0, cbuf, pbuf, Ct);
  241.             }
  242.         }
  243.         overflow = No;
  244.         if (n > (inner ? Maxinner : Maxbottom)) {
  245.             overflow = Yes;
  246.             n2 = (n-1)/2;
  247.             n -= n2+1;
  248.         }
  249.         else if (n < (inner ? Mininner : Minbottom))
  250.             underflow = Yes;
  251.         q1 = grabbtreenode(inner ? Inner : Bottom, Ct);
  252.         Lim(q1) = n;
  253.         cp = cbuf;
  254.         strncpy((inner ? &Ichar(q1, 0) : &Bchar(q1, 0)), cp, n);
  255.         cp += n;
  256.         if (inner) {
  257.             pp = pbuf;
  258.             i = movnptrs(&Ptr(q1, 0), pp, n+1);
  259.             Incr(pp, n+1);
  260.             n += i;
  261.         }
  262.         Size(q1) = n;
  263.         if (overflow) {
  264.             newitem = *cp++;
  265.             q2 = grabbtreenode(inner ? Inner : Bottom, Ct);
  266.             Lim(q2) = n2;
  267.             strncpy((inner ? &Ichar(q2, 0) : &Bchar(q2, 0)), cp, n2);
  268.             if (inner)
  269.                 n2 += movnptrs(&Ptr(q2, 0), pp, n2+1);
  270.             Size(q2) = n2;
  271.         }
  272.         inner = Yes;
  273.     }
  274.     if (overflow)
  275.         q1 = mknewroot(q1, (itemptr)&newitem, q2, Ct);
  276.     return q1;
  277. #undef q1
  278. #undef q2
  279. }
  280.  
  281. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  282.  
  283. Hidden value ibehead(v, h) value v; int h; { /* v@h */
  284.     stack s; stackptr sp;
  285.     sp = (stackptr) unzip(Root(v), h-1, s);
  286.     v = grab_tlt(Tex, Ct);
  287.     Root(v) = zip(Snil, Snil, s, sp);
  288.     return v;
  289. }
  290.  
  291. Hidden value icurtail(v, t) value v; int t; { /* v|t */
  292.     stack s; stackptr sp;
  293.     sp = (stackptr) unzip(Root(v), t, s);
  294.     v = grab_tlt(Tex, Ct);
  295.     Root(v) = zip(s, sp, Snil, Snil);
  296.     return v;
  297. }
  298.  
  299. Hidden value iconcat(v, w) value v, w; { /* v^w */
  300.     stack s1, s2;
  301.     stackptr sp1 = (stackptr) unzip(Root(v), Tltsize(v), s1);
  302.     stackptr sp2 = (stackptr) unzip(Root(w), 0, s2);
  303.     v = grab_tlt(Tex, Ct);
  304.     Root(v) = zip(s1, sp1, s2, sp2);
  305.     return v;
  306. }
  307.  
  308. #define Odd(n) (((n)&1) != 0)
  309.  
  310. Hidden value irepeat(v, n) value v; int n; { /* v^^n */
  311.     value x, w = grab_tlt(Tex, Ct);
  312.     Root(w) = Bnil;
  313.     v = copy(v);
  314.     while (n > 0) {
  315.         if (Odd(n)) {
  316.             w = iconcat(x = w, v);
  317.             release(x);
  318.         }
  319.         n /= 2;
  320.         if (n == 0)
  321.             break;
  322.         v = iconcat(x = v, v);
  323.         release(x);
  324.     }
  325.     release(v);
  326.     return w;
  327. }
  328.  
  329. #ifdef UNUSED_CODE
  330. Hidden value jrepeat(v, n) value v; int n; { /* v^^n, recursive solution */
  331.     value w, x;
  332.     if (n <= 1) {
  333.         if (n == 1)
  334.             return copy(v);
  335.         w = grab_tlt(Tex, Ct);
  336.         Root(w) = Bnil;
  337.         return w;
  338.     }
  339.     w = jrepeat(v, n/2);
  340.     w = iconcat(x = w, w);
  341.     release(x);
  342.     if (Odd(n)) {
  343.         w = iconcat(x = w, v);
  344.         release(x);
  345.     }
  346.     return w;
  347. }
  348. #endif UNUSED_CODE
  349.  
  350. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  351.  
  352. Visible value curtail(t, after) value t, after; {
  353.     int syzcurv, syztext;
  354.  
  355.     if (!Is_text(t)) {
  356.         reqerr(MESS(1602, "in t|n, t is not a text"));
  357.         return Vnil;
  358.     }
  359.     if (!Is_number(after)) {
  360.         reqerr(MESS(1603, "in t|n, n is not a number"));
  361.         return Vnil;
  362.     }
  363.     syztext = Tltsize(t);
  364.     if (syztext == Bigsize)
  365.         syserr(MESS(1604, "curtail on very big text"));
  366.     if (large(after) || (syzcurv = intval(after)) < 0
  367.         || syztext < syzcurv) {
  368.         reqerr(MESS(1605, "in t|n, n is out of bounds"));
  369.         return Vnil;
  370.     }
  371.     return icurtail(t, syzcurv);
  372. }
  373.  
  374. Visible value behead(t, before) value t, before; {
  375.     int syzbehv, syztext;
  376.  
  377.     if (!Is_text(t)) {
  378.         reqerr(MESS(1606, "in t@n, t is not a text"));
  379.         return Vnil;
  380.     }
  381.     if (!Is_number(before)) {
  382.         reqerr(MESS(1607, "in t@n, n is not a number"));
  383.         return Vnil;
  384.     }
  385.     syztext = Tltsize(t);
  386.     if (syztext == Bigsize) syserr(MESS(1608, "behead on very big text"));
  387.     if (large(before) || (syzbehv = intval(before)) <= 0
  388.         || syztext < syzbehv-1) {
  389.         reqerr(MESS(1609, "in t@n, n is out of bounds"));
  390.         return Vnil;
  391.     }
  392.     return ibehead(t, syzbehv);
  393. }
  394.  
  395. #ifdef NOT_USED
  396. Visible value trim(v, b, c) value v; intlet b, c; { /*temporary*/
  397.     /* Only used in f_uname */
  398.     int len= Tltsize(v);
  399.     value r= ibehead(v, b+1), s;
  400.     s= icurtail(r, len-b-c); release(r);
  401.     return s;
  402. }
  403. #endif
  404.  
  405. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  406.  
  407. Visible value concat(tleft, tright) value tleft, tright; {
  408.     int syzleft, syzright;
  409.     if (!Is_text(tleft) || !Is_text(tright)) {
  410.         reqerr(MESS(1610, "in t^u, t or u is not a text"));
  411.         return Vnil;
  412.     }
  413.     syzleft = Tltsize(tleft);
  414.     syzright =  Tltsize(tright);
  415.     if (syzleft == Bigsize || syzright == Bigsize)
  416.         syserr(MESS(1611, "concat on very big text"));
  417.     if (syzleft > Maxint-syzright
  418.         || syzright > Maxint-syzleft) {
  419.         reqerr(MESS(1612, "in t^u, the result is too long"));
  420.         return Vnil;
  421.     }
  422.     return iconcat(tleft, tright);
  423. }
  424.  
  425. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  426.  
  427. Visible value repeat(t, n) value t, n; {
  428.     int tsize, k;
  429.  
  430.     if (!Is_text(t)) {
  431.         reqerr(MESS(1613, "in t^^n, t is not a text"));
  432.         return Vnil;
  433.     }
  434.     if (!Is_number(n)) {
  435.         reqerr(MESS(1614, "in t^^n, n is not a number"));
  436.         return Vnil;
  437.     }
  438.     if (numcomp(n, zero) < 0) {
  439.         reqerr(MESS(1615, "in t^^n, n is negative"));
  440.         return Vnil;
  441.     }
  442.     tsize = Tltsize(t);
  443.     if (tsize == 0) return copy(t);
  444.  
  445.     if (large(n) || Maxint/tsize < (k = intval(n))) {
  446.         reqerr(MESS(1616, "in t^^n, the result is too long"));
  447.         return Vnil;
  448.     }
  449.     return irepeat(t, k);
  450. }
  451.  
  452. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  453.  
  454. Visible Procedure wrtext(putch, v, quote) int (*putch)(); value v; char quote; {
  455.     if (v == Vnil || !Is_text(v)) {
  456.         (*putch)('?');
  457.         return;
  458.     }
  459.     if (quote) (*putch)(quote);
  460.     if (Root(v) != Bnil) wrbtext(putch, Root(v), quote);
  461.     if (quote) (*putch)(quote);
  462. }
  463.  
  464. Hidden Procedure wrbtext(putch, p, quote)
  465.  int (*putch)(); btreeptr p; char quote; {
  466.     int i, n = Lim(p); char c;
  467.     if (IsInner(p)) {
  468.         for (i = 0; still_ok && i < n; ++i) {
  469.             wrbtext(putch, Ptr(p, i), quote);
  470.             c = Ichar(p, i);
  471.             (*putch)(c);
  472.             if (quote && (c == quote || c == '`')) (*putch)(c);
  473.         }
  474.         wrbtext(putch, Ptr(p, i), quote);
  475.     }
  476.     else if (quote) {
  477.         for (i = 0; i < n; ++i) {
  478.             c = Bchar(p, i);
  479.             (*putch)(c);
  480.             if (c == quote || c == '`') (*putch)(c);
  481.         }
  482.     }
  483.     else {
  484.         for (i = 0; i < n; ++i) (*putch)(Bchar(p, i));
  485.     }
  486. }
  487.  
  488. #else INTEGRATION
  489.  
  490. Visible value mk_text(m) string m; {
  491.     value v; intlet len= strlen(m);
  492.     v= grab_tex(len);
  493.     strcpy(Str(v), m);
  494.     return v;
  495. }
  496.  
  497. Visible bool character(v) value v; {
  498.     if (Is_text(v) && Length(v) == 1) return Yes;
  499.     else return No;
  500. }
  501.  
  502. Visible char charval(v) value v; {
  503.     if (!Is_text(v) || Length(v) != 1) error(MESS(1617, "value not a character"));
  504.     return *Str(v);
  505. }
  506.  
  507. Visible string strval(v) value v; {
  508.     return Str(v);
  509. }
  510.  
  511. Visible value concat(s, t) value s, t; {
  512.     if (Type(s) != Tex)
  513.         error(MESS(1618, "in t^u, t is not a text"));
  514.     else if (Type(t) != Tex)
  515.         error(MESS(1619, "in t^u, t is a text, but u is not"));
  516.     else {
  517.         value c= grab_tex(Length(s)+Length(t));
  518.         strcpy(Str(c), Str(s)); strcpy(Str(c)+Length(s), Str(t));
  519.         return c;
  520.     }
  521.     return grab_tex(0);
  522. }
  523.  
  524. #define VERSION2
  525.  
  526. Visible Procedure concato(s, t) value *s; string t; {
  527.     if (Type(*s) != Tex)
  528.         error(MESS(1620, "attempt to join text with non-text"));
  529.     else {
  530. #ifdef VERSION1
  531.         xtndtex(s, strlen(t));
  532.         strcat(Str(*s), t);
  533. #endif
  534. #ifdef VERSION2
  535.         value v= mk_text(t);
  536.         value w= concat(*s, v);
  537.         release(*s); release(v);
  538.         *s= w;
  539. #endif
  540.     }
  541. }
  542.  
  543. Visible value trim(v, B, C) value v; intlet B, C; {
  544.     intlet len= Length(v), k;
  545.     if (Type(v) != Tex)
  546.         error(MESS(1621, "trim (@ or |) applied to non-text"));
  547.     else if (B < 0 || C < 0 || B+C > len)
  548.         error(MESS(1622, "trim (@ or |) out of bounds"));
  549.     else {
  550.         value w= grab_tex(len-=(B+C));
  551.         string vp= Str(v)+B, wp= Str(w);
  552.         Overall *wp++= *vp++; *wp= '\0';
  553.         return w;
  554.     }
  555.     return grab_tex(0);
  556. }
  557.  
  558. Visible Procedure
  559. putintrim(pn, head, tail, str)
  560.     value *pn;
  561.     intlet head, tail;
  562.     string str;
  563. {
  564.     value v = *pn;
  565.     intlet len= Length(v);
  566.  
  567.     if (Type(v) != Tex)
  568.         error(MESS(1623, "putintrim (@ or |) applied to non-text"));
  569.     else if (head < 0 || tail < 0 || head+tail > len)
  570.         error(MESS(1624, "putintrim (@ or |) out of bounds"));
  571.     else {
  572.         value w = head == 0 ? mk_text("") :
  573.             head == len ? copy(v) : trim(v, 0, len - head);
  574.         if (*str)
  575.             concato(&w, str);
  576.         if (tail > 0)
  577.             concato(&w, Str(v)+(len - tail));
  578.         release(v);
  579.         *pn = w;
  580.     }
  581. }
  582.  
  583. Visible value curtail(v, n) value v, n; {
  584.     intlet c= intval(n);
  585.     v= trim(v, 0, Length(v) - c);
  586.     return v;
  587. }
  588.  
  589. Visible value behead(v, n) value v, n; {
  590.     intlet b= intval(n);
  591.     v= trim(v, b-1, 0);
  592.     return v;
  593. }
  594.  
  595. Visible value repeat(x, y) value x, y; {
  596.     intlet i= propintlet(intval(y));
  597.     if (Type(x) != Tex)
  598.         error(MESS(1625, "in t^^n, t is not a text"));
  599.     if (i < 0)
  600.         error(MESS(1626, "in t^^n, n is negative"));
  601.     else {
  602.         value r; string xp, rp; intlet p, q, xl= Length(x);
  603.         r= grab_tex(propintlet(i*xl));
  604.         rp= Str(r);
  605.         for (p= 0; p < i; p++) {
  606.             xp= Str(x);
  607.             for (q= 0; q < xl; q++) *rp++= *xp++;
  608.         }
  609.         *rp= '\0';
  610.         return r;
  611.     }
  612.     return grab_tex(0);
  613. }
  614.  
  615. #define Left 'L'
  616. #define Right 'R'
  617. #define Centre 'C'
  618.  
  619. Hidden value adj(x, y, side) value x, y; literal side; {
  620.     value r, v= convert(x, Yes, Yes); int i= intval(y);
  621.     intlet lv= Length(v), la, k, ls, rs;
  622.     string rp, vp;
  623.     la= propintlet(i) - lv;
  624.     if (la <= 0) return v;
  625.     r= grab_tex(lv+la); rp= Str(r); vp= Str(v);
  626.  
  627.     if (side == Left) { ls= 0; rs= la; }
  628.     else if (side == Centre) { ls= la/2; rs= (la+1)/2; }
  629.     else { ls= la; rs= 0; }
  630.  
  631.     for (k= 0; k < ls; k++) *rp++= ' ';
  632.     for (k= 0; k < lv; k++) *rp++= *vp++;
  633.     for (k= 0; k < rs; k++) *rp++= ' ';
  634.     *rp= 0;
  635.     release(v);
  636.     return r;
  637. }
  638.  
  639. Visible value adjleft(x, y) value x, y; {
  640.     return adj(x, y, Left);
  641. }
  642.  
  643. Visible value centre(x, y) value x, y; {
  644.     return adj(x, y, Centre);
  645. }
  646.  
  647. Visible value adjright(x, y) value x, y; {
  648.     return adj(x, y, Right);
  649. }
  650.  
  651. /* For reasons of efficiency, wri does not always call convert but writes
  652.    directly on the standard output. Modifications in convert should
  653.    be mirrored by changes in wri and vice versa. */
  654.  
  655. Visible value convert(v, coll, outer) value v; bool coll, outer; {
  656.     literal type= Type(v); intlet len= Length(v), k; value *vp= Ats(v);
  657.     value t, cv;
  658.     switch (type) {
  659.     case Num:
  660.         return mk_text(convnum(v));
  661.     case Tex:
  662.         if (outer) return copy(v);
  663.         else {string tp= (string) vp; char cs[2];
  664.             cs[1]= '\0';
  665.             t= mk_text("'");
  666.             Overall {
  667.                 cs[0]= *tp++;
  668.                 concato(&t, cs);
  669.                 if (cs[0] == '\'' || cs[0] == '`')
  670.                     concato(&t, cs);
  671.             }
  672.             concato(&t, "'");
  673.             return t;
  674.         }
  675.     case Com:
  676.         outer&= coll;
  677.         t= mk_text(coll ? "" : "(");
  678.         Overall {
  679.             concato(&t, Str(cv= convert(*vp++, No, outer)));
  680.             release(cv);
  681.             if (k != len-1) concato(&t, outer ? " " : ", ");
  682.         }
  683.         if (!coll) concato(&t, ")");
  684.         return t;
  685.     case Lis: case ELT:
  686.         t= mk_text("{");
  687.         Overall {
  688.             concato(&t, Str(cv= convert(*vp++, No, No)));
  689.             release(cv);
  690.             if (k != len-1) concato(&t, "; ");
  691.         }
  692.         concato(&t, "}");
  693.         return t;
  694.     case Tab:
  695.         t= mk_text("{");
  696.         Overall {
  697.             concato(&t, "[");
  698.             concato(&t, Str(cv= convert(Cts(*vp), Yes, No)));
  699.             release(cv);
  700.             concato(&t, "]: ");
  701.             concato(&t, Str(cv= convert(Dts(*vp++), No, No)));
  702.             release(cv);
  703.             if (k != len-1) concato(&t, "; ");
  704.         }
  705.         concato(&t, "}");
  706.         return t;
  707.     default:
  708.         syserr(MESS(1627, "converting value of unknown type"));
  709.         return (value) Dummy;
  710.     }
  711. }
  712.  
  713. #endif INTEGRATION
  714.